{-
 Copyright 2022-23, Juspay India Pvt Ltd

 This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License

 as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program

 is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY

 or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more details. You should have received a copy of

 the GNU Affero General Public License along with this program. If not, see <https://www.gnu.org/licenses/>.
-}

module SharedLogic.BehaviourManagement.CancellationRate where

import qualified Domain.Types.DriverInformation as DI
import qualified Domain.Types.MerchantOperatingCity as DMOC
import qualified Domain.Types.Person as DP
import Domain.Types.TransporterConfig
import qualified Kernel.External.Notification.FCM.Types as FCM
import Kernel.External.Types (Language (..))
import Kernel.Prelude
import qualified Kernel.Storage.Hedis as Redis
import Kernel.Types.Error
import Kernel.Types.Id
import qualified Kernel.Types.SlidingWindowCounters as SWC
import Kernel.Utils.Common
import qualified Kernel.Utils.SlidingWindowCounters as SWC
import Lib.Scheduler.Environment
import SharedLogic.External.LocationTrackingService.Types
import qualified SharedLogic.Person as SPerson
import qualified Storage.Cac.TransporterConfig as CTC
import qualified Storage.CachedQueries.Merchant.Overlay as CMP
import qualified Storage.Queries.DriverInformation as QDriverInformation
import Tools.Error
import Tools.Metrics (CoreMetrics)
import Tools.Notifications as Notify

data CancellationRateData = CancellationRateData
  { assignedCount :: Int,
    cancelledCount :: Int,
    cancellationRate :: Int,
    windowSize :: Int,
    assignedCountDaily :: Int,
    cancelledCountDaily :: Int,
    assignedCountWeekly :: Int,
    cancelledCountWeekly :: Int
  }
  deriving (Show, Eq, Generic, ToJSON, FromJSON)

mkRideAssignedKey :: Text -> Text
mkRideAssignedKey driverId = "driver-offer:CR:assigned-dId:" <> driverId

mkRideCancelledKey :: Text -> Text
mkRideCancelledKey driverId = "driver-offer:CR:cancelled-dId:" <> driverId

getWindowSize :: (MonadFlow m, EsqDBFlow m r, CacheFlow m r) => Id DMOC.MerchantOperatingCity -> m Integer
getWindowSize mocId = do
  merchantConfig <- CTC.findByMerchantOpCityId mocId Nothing >>= fromMaybeM (TransporterConfigNotFound mocId.getId)
  pure $ toInteger $ fromMaybe 7 merchantConfig.cancellationRateWindow

incrementCancelledCount ::
  ( Redis.HedisFlow m r,
    EsqDBFlow m r,
    CacheFlow m r
  ) =>
  Id DP.Person ->
  Integer ->
  m ()
incrementCancelledCount driverId windowSize = Redis.withCrossAppRedis $ SWC.incrementWindowCount (mkRideCancelledKey driverId.getId) (SWC.SlidingWindowOptions windowSize SWC.Days)

incrementAssignedCount ::
  ( Redis.HedisFlow m r,
    EsqDBFlow m r,
    CacheFlow m r
  ) =>
  Id DP.Person ->
  Integer ->
  m ()
incrementAssignedCount driverId windowSize = Redis.withCrossAppRedis $ SWC.incrementWindowCount (mkRideAssignedKey driverId.getId) (SWC.SlidingWindowOptions windowSize SWC.Days)

getCancellationCount ::
  ( Redis.HedisFlow m r,
    EsqDBFlow m r,
    CacheFlow m r
  ) =>
  Integer ->
  Id DP.Person ->
  m Integer
getCancellationCount windowSize driverId = Redis.withCrossAppRedis $ SWC.getCurrentWindowCount (mkRideCancelledKey driverId.getId) (SWC.SlidingWindowOptions windowSize SWC.Days)

getAssignedCount ::
  ( Redis.HedisFlow m r,
    EsqDBFlow m r,
    CacheFlow m r
  ) =>
  Integer ->
  Id DP.Person ->
  m Integer
getAssignedCount windowSize driverId = Redis.withCrossAppRedis $ SWC.getCurrentWindowCount (mkRideAssignedKey driverId.getId) (SWC.SlidingWindowOptions windowSize SWC.Days)

getCancellationRateData ::
  (MonadFlow m, CacheFlow m r, EsqDBFlow m r) =>
  Id DMOC.MerchantOperatingCity ->
  Id DP.Person ->
  m (Maybe CancellationRateData)
getCancellationRateData mocId driverId = do
  merchantConfig <- CTC.findByMerchantOpCityId mocId Nothing >>= fromMaybeM (TransporterConfigNotFound mocId.getId)
  let minimumRides = findMinimumRides merchantConfig
  let windowSize = findWindowSize merchantConfig
  assignedCount <- getAssignedCount windowSize driverId
  if (isJust merchantConfig.cancellationRateWindow) && (assignedCount > minimumRides)
    then do
      cancelledCount <- getCancellationCount windowSize driverId
      let cancellationRate = (cancelledCount * 100) `div` max 1 assignedCount

      (cancelledCountDaily, assignedCountDaily) <- getCancellationRateOfDaysStandalone driverId 1 windowSize
      (cancelledCountWeekly, assignedCountWeekly) <- getCancellationRateOfDaysStandalone driverId 7 windowSize
      pure $
        Just $
          CancellationRateData
            { assignedCount = fromInteger assignedCount,
              cancelledCount = fromInteger cancelledCount,
              cancellationRate = fromInteger cancellationRate,
              windowSize = fromMaybe 7 merchantConfig.cancellationRateWindow,
              assignedCountDaily = fromInteger assignedCountDaily,
              cancelledCountDaily = fromInteger cancelledCountDaily,
              assignedCountWeekly = fromInteger assignedCountWeekly,
              cancelledCountWeekly = fromInteger cancelledCountWeekly
            }
    else pure Nothing
  where
    findWindowSize merchantConfig = toInteger $ fromMaybe 7 merchantConfig.cancellationRateWindow
    findMinimumRides merchantConfig = toInteger $ fromMaybe 5 merchantConfig.cancellationRateCalculationThreshold

getCancellationRateOfDaysStandalone ::
  (MonadFlow m, CacheFlow m r, EsqDBFlow m r) =>
  Id DP.Person ->
  Integer ->
  Integer ->
  m (Integer, Integer)
getCancellationRateOfDaysStandalone driverId period windowSize = do
  cancelledCount <- fmap (sum . map (fromMaybe 0)) $ Redis.withCrossAppRedis $ SWC.getCurrentWindowValuesUptoLast period (mkRideCancelledKey driverId.getId) (SWC.SlidingWindowOptions windowSize SWC.Days)
  assignedCount <- fmap (sum . map (fromMaybe 0)) $ Redis.withCrossAppRedis $ SWC.getCurrentWindowValuesUptoLast period (mkRideAssignedKey driverId.getId) (SWC.SlidingWindowOptions windowSize SWC.Days)
  return (cancelledCount, assignedCount)

nudgeOrBlockDriver ::
  (MonadFlow m, CacheFlow m r, EsqDBFlow m r, CoreMetrics m, HasLocationService m r, JobCreator r m, HasShortDurationRetryCfg r c) =>
  TransporterConfig ->
  DP.Person ->
  DI.DriverInformation ->
  m ()
nudgeOrBlockDriver transporterConfig driver driverInfo = do
  let config = buildConfig
  now <- getCurrentTime
  case (transporterConfig.cancellationRateWindow, config) of
    (Just windowSize, Just CancellationRateBasedNudgingAndBlockingConfig {..}) -> do
      (dailyCancellationRate, dailyAssignedCount) <- getCancellationRateOfDays 1 windowSize
      (weeklyCancellationRate, weeklyAssignedCount) <- getCancellationRateOfDays 7 windowSize
      let mbCooldDownWeekly = driverInfo.weeklyCancellationRateBlockingCooldown
          mbCooldDownDaily = driverInfo.dailyCancellationRateBlockingCooldown
      logDebug $ "All cancellation rate data for driverId: " <> driver.id.getId <> ": dailyCancellationRate: " <> show dailyCancellationRate <> " dailyAssignedCount: " <> show dailyAssignedCount <> " weeklyCancellationRate: " <> show weeklyCancellationRate <> " weeklyAssignedCount: " <> show weeklyAssignedCount <> "cancellationrateslabconfig" <> show cancellationRateSlabConfig

      (canBlockOnWeekly, canBlockOnDaily, weeklyOffenceSuspensionTimeHoursParam, dailyOffenceSuspensionTimeHoursParam) <- case cancellationRateSlabConfig of
        Nothing -> do
          return
            ( isDriverBlockable cancellationRateThresholdWeekly weeklyMinRidesforBlocking weeklyCancellationRate weeklyAssignedCount mbCooldDownWeekly now,
              isDriverBlockable cancellationRateThresholdDaily dailyMinRidesforBlocking dailyCancellationRate dailyAssignedCount mbCooldDownDaily now,
              weeklyOffenceSuspensionTimeHours,
              dailyOffenceSuspensionTimeHours
            )
        Just configData -> do
          let matchingWeeklySlab = find (\slab -> isDriverBlockableSlab (slab.penalityForCancellation.cancellationPercentageThreshold) (slab.minBookingsRange) weeklyCancellationRate weeklyAssignedCount slab.penalityForCancellation.suspensionTimeInHours mbCooldDownWeekly now) (configData.weeklySlabs)
          (canBlockOnWeekly', weeklyOffenceSuspensionTimeHoursParam') <- case matchingWeeklySlab of
            Just slab -> return (True, slab.penalityForCancellation.suspensionTimeInHours)
            Nothing -> return (False, weeklyOffenceSuspensionTimeHours)

          let matchingDailySlab =
                find
                  ( \slab ->
                      isDriverBlockableSlab
                        slab.penalityForCancellation.cancellationPercentageThreshold
                        slab.minBookingsRange
                        dailyCancellationRate
                        dailyAssignedCount
                        slab.penalityForCancellation.suspensionTimeInHours
                        mbCooldDownDaily
                        now
                  )
                  configData.dailySlabs

          (canBlockOnDaily', dailyOffenceSuspensionTimeHoursParam') <- case matchingDailySlab of
            Just slab -> return (True, slab.penalityForCancellation.suspensionTimeInHours)
            Nothing -> return (False, dailyOffenceSuspensionTimeHours)

          return (canBlockOnWeekly', canBlockOnDaily', weeklyOffenceSuspensionTimeHoursParam', dailyOffenceSuspensionTimeHoursParam')
      case (canBlockOnWeekly, canBlockOnDaily, weeklyOffenceSuspensionTimeHoursParam, dailyOffenceSuspensionTimeHoursParam) of
        (True, _, weeklyOffenceSuspensionTimeHoursParam', _) -> do
          SPerson.blockDriverTemporarily driver.merchantId driver.merchantOperatingCityId driver.id "BLOCKED_BASED_ON_CANCELLATION_RATE" weeklyOffenceSuspensionTimeHoursParam' CancellationRateWeekly
          let calculatedCooldownTime = addUTCTime (fromIntegral weeklyConditionCooldownTimeHours * 60 * 60) now
              finalCooldown = whenFirstJustReturnMaxElseReturnSecond mbCooldDownWeekly calculatedCooldownTime
          QDriverInformation.updateWeeklyCancellationRateBlockingCooldown (Just finalCooldown) driver.id
        (_, True, _, dailyOffenceSuspensionTimeHoursParam') -> do
          SPerson.blockDriverTemporarily driver.merchantId driver.merchantOperatingCityId driver.id "BLOCKED_BASED_ON_CANCELLATION_RATE" dailyOffenceSuspensionTimeHoursParam' CancellationRateDaily
          let calculatedCooldownTime = addUTCTime (fromIntegral dailyConditionCooldownTimeHours * 60 * 60) now
              finalDailyCoolDown = whenFirstJustReturnMaxElseReturnSecond mbCooldDownDaily calculatedCooldownTime
              finalyWeeklyCoolDown = whenFirstJustReturnMaxElseReturnSecond mbCooldDownWeekly calculatedCooldownTime
          QDriverInformation.updateDailyAndWeeklyCancellationRateBlockingCooldown (Just finalDailyCoolDown) (Just finalyWeeklyCoolDown) driver.id
        _ -> do
          when (canNudgeDriver cancellationRateThresholdWeekly weeklyMinRidesforNudging weeklyMinRidesforBlocking weeklyCancellationRate weeklyAssignedCount) $ do
            nudgeDriver weeklyCancellationRate FCM.CANCELLATION_RATE_NUDGE_WEEKLY "CANCELLATION_RATE_NUDGE_WEEKLY"
          when (canNudgeDriver cancellationRateThresholdDaily dailyMinRidesforNudging dailyMinRidesforBlocking dailyCancellationRate dailyAssignedCount) $ do
            nudgeDriver dailyCancellationRate FCM.CANCELLATION_RATE_NUDGE_DAILY "CANCELLATION_RATE_NUDGE_DAILY"
    _ -> logInfo "cancellationRateWindow or cancellationRateBasedNudgingAndBlockingConfig not found in transporter config"
  where
    canNudgeDriver cancellationRateThreshold minAssignedRides maxAssignedRides cancellationRate rideAssignedCount =
      (cancellationRate > cancellationRateThreshold) && (rideAssignedCount > minAssignedRides && rideAssignedCount <= maxAssignedRides)

    whenFirstJustReturnMaxElseReturnSecond mbCooldown calculatedCooldown =
      case mbCooldown of
        Just cool -> max cool calculatedCooldown
        Nothing -> calculatedCooldown

    isDriverBlockable cancellationRateThreshold rideAssignedThreshold cancellationRate assignedCount mbCooldown now =
      let rule = (cancellationRate >= cancellationRateThreshold) && (assignedCount >= rideAssignedThreshold)
       in case mbCooldown of
            Just cooldown -> rule && (cooldown <= now)
            Nothing -> rule

    isDriverBlockableSlab cancellationRateThreshold rideAssignedThreshold cancellationRate assignedCount suspensionTimeInHours mbCooldown now =
      let rule = maybe False (\minRides -> maybe False (\maxRides -> (cancellationRate >= cancellationRateThreshold) && (assignedCount >= minRides) && (assignedCount <= maxRides) && (suspensionTimeInHours > 0)) (listToMaybe (reverse rideAssignedThreshold))) (listToMaybe rideAssignedThreshold)
       in case mbCooldown of
            Just cooldown -> rule && (cooldown <= now)
            Nothing -> rule

    getCancellationRateOfDays period windowSize = do
      let windowInt = toInteger windowSize
      cancelledCount <- fmap (sum . map (fromMaybe 0)) $ Redis.withCrossAppRedis $ SWC.getCurrentWindowValuesUptoLast period (mkRideCancelledKey driver.id.getId) (SWC.SlidingWindowOptions windowInt SWC.Days)
      assignedCount <- fmap (sum . map (fromMaybe 0)) $ Redis.withCrossAppRedis $ SWC.getCurrentWindowValuesUptoLast period (mkRideAssignedKey driver.id.getId) (SWC.SlidingWindowOptions windowInt SWC.Days)
      let cancellationRate = ((cancelledCount) * 100) `div` max 1 (assignedCount)
      return (cancellationRate, assignedCount)

    nudgeDriver cancellationRate fcmType pnKey = do
      overlay <- CMP.findByMerchantOpCityIdPNKeyLangaugeUdfVehicleCategory driver.merchantOperatingCityId pnKey (fromMaybe ENGLISH driver.language) Nothing Nothing Nothing >>= fromMaybeM (InternalError $ "Overlay not found for " <> pnKey)
      let fcmOverlayReq = Notify.mkOverlayReq overlay
      let entityData = Notify.CancellationRateBaseNudgeData {driverId = driver.id.getId, driverCancellationRate = cancellationRate}
      Notify.sendCancellationRateNudgeOverlay driver.merchantOperatingCityId driver fcmType fcmOverlayReq entityData

    buildConfig :: Maybe CancellationRateBasedNudgingAndBlockingConfig
    buildConfig = do
      cancellationRateThresholdDaily <- transporterConfig.cancellationRateThresholdDaily
      cancellationRateThresholdWeekly <- transporterConfig.cancellationRateThresholdWeekly
      dailyMinRidesforBlocking <- transporterConfig.dailyMinRidesForBlocking
      weeklyMinRidesforBlocking <- transporterConfig.weeklyMinRidesForBlocking
      dailyMinRidesforNudging <- transporterConfig.dailyMinRidesForNudging
      weeklyMinRidesforNudging <- transporterConfig.weeklyMinRidesForNudging
      dailyOffenceSuspensionTimeHours <- transporterConfig.dailyOffenceSuspensionTimeHours
      weeklyOffenceSuspensionTimeHours <- transporterConfig.weeklyOffenceSuspensionTimeHours
      dailyConditionCooldownTimeHours <- transporterConfig.dailyConditionCooldownTimeHours
      weeklyConditionCooldownTimeHours <- transporterConfig.weeklyConditionCooldownTimeHours
      let cancellationRateSlabConfig = transporterConfig.cancellationRateSlabConfig
      return CancellationRateBasedNudgingAndBlockingConfig {..}
